home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / amok_lha / amok18.lha / Profile / Demos / Prim2.pro < prev    next >
Text File  |  1993-08-15  |  1KB  |  50 lines
  1. MODULE Prim2;
  2.  
  3. FROM InOut IMPORT WriteInt;
  4.  
  5. CONST n = 1000;
  6.  
  7. VAR i,k: INTEGER;
  8. (* k: min = 2, max = 31 *)
  9. (* i: min = 2, max = 1000 *)
  10.     prim: BOOLEAN;
  11. (* prim: min = 0, max = 1 *)
  12.  
  13. PROCEDURE Sqrt(a: INTEGER): INTEGER;
  14. (* a: min = 2, max = 1000 *)
  15. (* Der schnellste, mir bekannte Wurzel-Algorithmus.
  16.    Er prüft, in welchem Zahlenbereich a ist und nimmt davon ausgehend die
  17.    erste Näherung. Die Steigung der Wurzelfunktion in den verschiedenen
  18.    Bereichen wird als konstant angesehen. Das Ergebnis wird um 1 vermindert,
  19.    wenn es größer als sqr(a) ist, damit es mit trunc(sqrt(a)) übereinstimmt *)
  20.  
  21. VAR b: INTEGER;
  22. (* b: min = 1, max = 31 *)
  23.  
  24. BEGIN
  25.  (* 999 Aufrufe *)
  26.   IF    a<8H    THEN b := a DIV   4H +  1H;
  27.   ELSIF a<20H   THEN b := a DIV   8H +  2H;
  28.   ELSIF a<80H   THEN b := a DIV  19H +  4H;
  29.   ELSIF a<200H  THEN b := a DIV  20H +  8H;
  30.   ELSIF a<800H  THEN b := a DIV  40H + 10H;
  31.   ELSIF a<2000H THEN b := a DIV  80H + 20H;
  32.   ELSIF a<8000H THEN b := a DIV 100H + 40H;
  33.   ELSE               b := a DIV 200H + 80H END;
  34.   b := (b + a DIV b) DIV 2; IF b*b>a THEN DEC(b) END;
  35.   RETURN b;
  36. END Sqrt;
  37.  
  38. BEGIN
  39.   FOR i:=2 TO n DO
  40.  (* 999 Durchläufe *)
  41.     prim := TRUE;
  42.     FOR k:=2 TO Sqrt(i) DO
  43.  (* 19615 Durchläufe *)
  44.       IF i MOD k = 0 THEN prim := FALSE END;
  45.     END;
  46.     IF prim THEN WriteInt(i,4) END;
  47.   END;
  48. END Prim2.
  49.  
  50.